home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / fractal / mandel.f < prev    next >
Text File  |  1993-06-28  |  3KB  |  95 lines
  1.       program mandel
  2.  
  3.       real xmin, xmax, ymin, ymax
  4.       integer width, height
  5.       integer bild (:,:), hostbild (:,:)
  6. cmf$  layout hostbild (:host)
  7.       logical mask (:,:)
  8.       logical done
  9.       integer hx1, hx2, hy1, hy2
  10.       integer maxtiefe
  11.       parameter (maxtiefe = 256)
  12.       real valmax
  13.       parameter (valmax = 40.0)
  14.       real xp(:,:), yp(:,:)
  15.       real x(:,:), y(:,:), xalt(:,:)
  16.  
  17.       print *, 'Input Width - Height '
  18.       print *, 'should always be a multiple of 4 '
  19.       read *, width, height
  20.  
  21.       allocate (bild(1:height,1:width))
  22.       allocate (hostbild(1:height,1:width))
  23.       allocate (mask(1:height,1:width))
  24.       allocate (xp(1:height,1:width))
  25.       allocate (yp(1:height,1:width))
  26.       allocate (x(1:height,1:width))
  27.       allocate (y(1:height,1:width))
  28.       allocate (xalt(1:height,1:width))
  29.  
  30.       call x_display_init (width, height)
  31.  
  32.       xmin = -2.0
  33.       xmax = 1.0
  34.       ymin = -1.0
  35.       ymax = 1.0
  36.       done = .false.
  37.       do while (.not. done )
  38.  
  39. !HPF$     INDEPENDENT, LOCAL_ACCESS
  40.           do i=1,height  
  41. !HPF$       INDEPENDENT, LOCAL_ACCESS
  42.             do j=1,width  
  43.               xp(i,j) = j
  44.             end do
  45.           end do
  46.           xp = (xmax - xmin) * xp 
  47.           xp = xp /width + xmin
  48.  
  49. !HPF$     INDEPENDENT, LOCAL_ACCESS
  50.           do j=1,width   
  51. !HPF$       INDEPENDENT, LOCAL_ACCESS
  52.             do i=1,height
  53.               yp(i,j) = i
  54.             end do
  55.           end do
  56.           yp = (ymax - ymin) * yp 
  57.           yp = yp /height + ymin
  58.  
  59. c         print *, 'xp = ', xp
  60. c         print *, 'yp = ', yp
  61.           x = 0.0
  62.           y = 0.0
  63.           bild = 0
  64.           DO K=1,MAXTIEFE
  65.            mask = ( (X*X+Y*Y) .LT. VALMAX )
  66.            WHERE ( mask )
  67.               XALT = X
  68.               X = (X*X-Y*Y) + XP
  69.               Y = (2*XALT*Y) + YP
  70.               BILD = BILD + 1
  71.            ENDWHERE
  72.          END DO
  73.  
  74.          hostbild = bild
  75.          call x_show_bild (hostbild,width,height)
  76.          call x_new_action (hx1,hx2,hy1,hy2)
  77.  
  78.          if ((hx1 .eq. 0) .or. (hx2 .eq. 0)) then
  79.              done = .true.
  80.            else
  81.              diffx = xmax - xmin
  82.              diffy = ymax - ymin
  83.              xmax = (diffx * hx2) / (width - 1) + xmin
  84.              ymax = (diffy * hy2) / (height - 1) + ymin
  85.              xmin = (diffx * hx1) / (width - 1) + xmin
  86.              ymin = (diffy * hy1) / (height - 1) + ymin
  87.          end if
  88.        end do
  89.        call x_display_exit ()
  90.  
  91.        deallocate (xalt, y, x, yp, xp)
  92.        deallocate (mask, hostbild, bild)
  93.  
  94.        end
  95.